perm filename HOLMES.SAI[P,JRA] blob
sn#430607 filedate 1979-04-01 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00031 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00004 00002 DEFINE CRLF="('15&'12)", !="comment", proc="simple procedure",
C00011 00003 ! define punch(x)=⊂wordout(ptpchan,x)⊃
C00012 00004 boolean procedure defile(integer chan string file,ext,pj,pn) begin ! file defaults
C00013 00005 proc cw_init(string sinteger n)
C00014 00006 proc cw_print(string sinteger n)
C00016 00007 ! procedure typeset(string s)
C00018 00008 proc punch_num(string s)
C00019 00009 proc tab_set(integer n)
C00020 00010 define
C00026 00011 ! character width stuff
C00027 00012 proc stuff(integer x) ! x is tty code, jam it in punch buffer
C00028 00013 procedure film_adv(string s) ! s is string rep of point, half-point advance
C00029 00014 procedure line_meas(integer n) ! n is pixel width of page. punch it
C00030 00015 proc indentto(integer n) ! manufacture the "bellIL" sequence
C00031 00016 proc tab_to(integer n) ! manufacture the guts of the bell X-Y
C00032 00017 proc tab_tofoot(integer n) ! manufacture the guts of the bell X-Y
C00033 00018 ! proc setfont(integer n)
C00035 00019 ! proc setfootfont(integer n)
C00037 00020 ! proc burp( reference integer array p: integer sup1, sub1, text)
C00038 00021 ! proc burpfoot( reference integer array p: integer sup1, sub1, text)
C00039 00022 ! proc punch_sum(string s)
C00040 00023 ! procedure setline ! end of line routine. must check for sup/sub hacking
C00043 00024 ! procedure setfootline ! end of line routine. must check for sup/sub hacking
C00046 00025 ! proc linesp(integer n)
C00047 00026 procedure set_foot
C00051 00027 procedure sethead
C00055 00028 begin "MAIN PROGRAM"
C00058 00029 add crap for page number location (suck for "<FF>")
C00059 00030 read page 1
C00062 00031 ! outstr("end of fonts")
C00067 ENDMK
C⊗;
DEFINE CRLF="('15&'12)", !="comment", proc="simple procedure",
crlfff="('15&'12&'14)",
crlfffsp="('15&'12&'14&'40)",
INCHAN=1,PTPCHAN=2,fontchan=3;
BEGIN "TYPESET"
require"⊂⊃⊂⊃"delimiters;
string s,s1,slead,swidth,ext;
integer lead,lmar,xline,width,pwidth,i,eof,pagebeg,pagend;
integer page,tolb,torb,tospeq,offset; ! offset is running left margin;
integer todot,tocolon;
boolean foo; ! the punch debug flag;
define debug(x)=⊂⊃;
! define debug(x)=⊂outstr(x)⊃;
PRELOAD_with
"Feed",
" th_sp ",
"e",
"3",
" ELEV",
"feed",
"a",
"$",
comment 10;
" ",
" adth ",
"s",
" emsp ",
"i",
"8",
"u",
"7",
comment 20;
"ret",
"'",
"d",
"-",
"r",
"4",
"j",
"BELL",
comment 30;
"n",
",",
"f",
" QL",
"c",
" ENSP ",
"k",
" QR",
comment 40;
"t",
"5",
"z",
")",
"l",
"SS",
"w",
"2",
comment 50;
"h",
" EML ",
"y",
"6",
"p",
"0",
"q",
" ENL ",
comment 60;
"o",
"9",
"b",
" URL ",
"g",
";",
"↑",
"LRL",
comment 70;
"m",
".",
"x",
"1",
"v",
" QC ",
"↓",
"RUB";string array vip[0:64];
PRELOAD_with
"a1","a3","a2","c1","b6","a2","a5","c2","a4","a3","c3","b3","b1","a4","a4","c3",
"c4", "c6", "a5", "a6","c5";
string array font[0:20];
PRELOAD_with
"10","10","10","10","10","10","10","10","10","24","10","08","10","12","12","10",
"10", "10", "10", "10","10";
string array fontsize[0:20]; ! extra slots for vip specials;
PRELOAD_with
0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0,
'15, 0, 0, 0, 0, 0, 0, 0,
0, '07, 0, 0, -'07, '23, '61, -'21,
'43, -'43, 0, 0, -'31, -'23, -'71, 0,
-'55, -'73, -'47, -'03, -'25, -'41, -'53, -'17,
-'15, -'61, '65, -'65, 0, 0, 0, '55,
0, '06, '62, '34, '22, '02, '32, '64,
'50, '14, '26, '36, '44, '70, '30, '60,
'54, '56, '24, '12, '40, '16, '74, '46,
'72, '52, '42, 0, 0, 0, 0, 0,
'21, -'06, -'62, -'34, -'22, -'02, -'32, -'64,
-'50, -'14, -'26, -'36, -'44, -'70, -'30, -'60,
-'54, -'56, -'24, -'12, -'40, -'16, -'74, -'46,
-'72, -'52, -'42, 0, 0, 0, 0, 0;
integer array chrtbl[0:128]; ! table encoding p-45 vip codes;
! table is indexed by ascii code;
! if entry is positive then its an uppercase character;
! if negative then it's a lower case;
! if entry is zero then hack special( typically greek math strip);
integer array cw[0:17,0:127]; ! font-character width array;
integer tab_cnt,! number of tabs set in line. used as index in tab_buf;
last_col;! last column set. current minus this gives bell setting;
string array tab_buf[0:20]; ! contains string rep of point pica setting;
integer run_lngth; ! used to count line length based on chr.width and COL INC's;
boolean seen_bnd; ! used in optimizer: no bands → no change in width;
boolean lft_qt; ! left-right quote flag;
integer page1,
topar, ! break table for parens;
loc, ! index in punch buffer;
supfont,! index of superscript font;
subfont;! for subscripts;
real pix_pnt; ! 200/72 approx ..... thi s is vertical pp;
real h_pix_pnt; ! 200/72 this is horiz. pp;
real def_width; ! the default page width hack ;
integer tabpos; ! setting for footnote indenting;
integer array punch_buf[0:1000];
boolean mon, ! `minus on' when is sum-script mode;
sup, ! a superscript is in the line;
sub, ! a subscript appears;
uc; ! upper case flag;
! next variables are used to minimize the crap put on tape;
! removing unnecessary font, point size, and indent changes;
string cur_size; ! current point size;
integer cur_font_no; ! current font number;
integer cur_indent; ! current indentation;
boolean text_set; ! true if current line has text characters (non-bells);
boolean foot; ! true when in footnote;
! tty codes (yuk);
define bell='27,
eight='15,
zero='55,
eexx='72,
dee='22,
gee='64,
jay='26,
kay='36,
emm='70,
en='30,
comma='31,
period='71,
eff='32,
elll='44,
yyii='52,
you='16,
zee='42,
emsp='13,
ensp='35,
bnd='10,
thin='1,
ql='33,
elev='04,
shift='66,
unshift='76,
supershift='45;
define flash='15,
noflash='61; ! these are for sumscripts( 8 and 9 in tty code)!;
define bellit=⊂begin
if not uc then stuff(bell)
else begin stuff(unshift);
stuff(bell);
uc←false;
end;
end⊃;
integer toppn; ! break table for ppn;
! define punch(x)=⊂wordout(ptpchan,x)⊃;
proc punch(integer x);
begin
if foo then outstr(vip[x]&crlf)else wordout(ptpchan,x);
end;
boolean procedure defile(integer chan; string file,ext,pj,pn); begin ! file defaults;
integer nam,ex,ppn; string sppn;
boolean flag;
nam←cvfil(file,ex,ppn); sppn←cvxstr(ppn);
sppn←"["&(if ppn lsh -18 then sppn[1 to 3] else pj)&","&
(if ppn land '777777 then sppn[4 to 6] else pn)&"]";
lookup(chan,(file←cvxstr(nam)&".")&cvxstr(ex)&sppn,flag);
if flag ∧ ex=0 then lookup(chan,file&ext&sppn,flag);
return(flag) ! TRUE if file not found;
end;
proc cw_init(string s;integer n);
begin "cw" string s1,file;integer i;boolean flag;
open(fontchan,"DSK",'14,2,0,0,0,eof);
s1←scan(s,toppn,i);
if length(s)=0 then file ← s1&".fnt[xgp,sys]"
else file ← s1&".fnt"&s;
lookup(fontchan,file,flag);
if flag then begin outstr("font not found");return;end;
for i←0 step 1 until 127 do
cw[n,i] ← wordin(fontchan) LSH -18;
if n=0 then begin "lead"
lead←wordin(fontchan); ! junk it;
lead←wordin(fontchan); ! get chr height;
end "lead";
release(fontchan);
end"cw";
proc cw_print(string s;integer n);
begin "cw" string s1,file;integer i,xx;boolean flag;
open(fontchan,"DSK",'14,2,0,0,0,eof);
s1←scan(s,toppn,i);
if length(s)=0 then file ← s1&".fnt[xgp,sys]"
else file ← s1&".fnt"&s;
lookup(fontchan,file,flag);
if flag then begin outstr("font not found");return;end;
outstr('14);
outstr("chr widths for font "&file&crlf);
outstr(" octal chr decimal width"&crlf);
for i←0 step 1 until 127 do begin "printloop"
cw[n,i] ← wordin(fontchan) LSH -18;
if i≠0 ∧ i≠8 ∧ i ≠9
∧ i≠10 ∧ i ≠11
∧ i ≠'14 ∧ i ≠'15
then
outstr(" "&cvos(i)&" "&i&" "&cvs(cw[n,i])&crlf);
end "printloop";
if n=0 then begin "lead"
lead←wordin(fontchan); ! junk it;
lead←wordin(fontchan); ! get chr height;
end "lead";
release(fontchan);
end"cw";
! procedure typeset(string s);
forward proc setfont(integer n);
forward proc setfootfont(integer n);
forward proc stuff(integer n);
forward proc tab_to(integer n);
forward proc typeset(string s);
forward proc special(string s);
proc typeset(string s);
begin "ty" integer s1;
debug(s&crlf);
while s ≠null do
begin "loop"
s1←lop(s);
if chrtbl[s1]>0 then begin
if uc then stuff(chrtbl[s1])
else begin stuff(shift);
stuff(chrtbl[s1]);
uc←true
end
end
else if chrtbl[s1]<0 then begin
if uc then begin stuff(unshift);
stuff(-chrtbl[s1]);
uc←false
end
else stuff(-chrtbl[s1])
end
else special(s1);
end "loop";
end "ty";
proc punch_num(string s);
begin "num" integer s1;
while s ≠null do
begin "loop"
s1←lop(s);
if chrtbl[s1]>0 then begin
outstr("bad pica-points for tab");
end
else if chrtbl[s1]<0 then begin
punch(-chrtbl[s1])
end
else outstr("bad pica-points for tab");
end "loop";
end"num";
proc tab_set(integer n);
begin "ty" integer i;string s;
i←1;
punch(bell);
punch(eexx);
while i<n do
begin "loop1"
s←tab_buf[i];
debug(s&crlf);
punch_num(s);
punch(bnd);
i←i+1;
end"loop1";
s←tab_buf[n];
debug(s&crlf);
punch_num(s);
punch(bell);
punch(yyii);
punch(bell);
punch(you);
end "ty";
define
grkss(n)=⊂begin
stuff(supershift);
stuff(n);
stuff(unshift);
uc←false;
end⊃,
grkuc(n)=⊂begin
if uc then stuff(n)
else begin stuff(shift);
stuff(n);
uc←true;
end;
end⊃,
grklc(n)=⊂begin
if not uc then stuff(n)
else begin stuff(unshift);
stuff(n);
uc←false
end;
end⊃;
proc special(string c); ! hack non-p45 character;
begin "sp"
integer n;
n←cur_font_no;
if c="≤" then begin
if foot then setfootfont(16)
else setfont(16);
grklc('30)
end
else if c="<" then begin
if foot then setfootfont(16)
else setfont(16);
grklc('72)
end
else if c="=" then begin
if foot then setfootfont(16)
else setfont(16);
grklc('50)
end
else if c="≥" then begin
if foot then setfootfont(16)
else setfont(16);
grklc('62)
end
else if c=">" then begin
if foot then setfootfont(16)
else setfont(16);
grklc('42)
end
else if c="{" then begin
if foot then setfootfont(19)
else setfont(19);
grkss('41)
end
else if c="}" then begin
if foot then setfootfont(19)
else setfont(19);
grkss('53)
end
else if c="≡" then begin
if foot then setfootfont(18)
else setfont(18);
grkss('15)
end
else if c="+" then begin
if foot then setfootfont(18)
else setfont(18);
grklc('73)
end
else if c="[" then begin
if foot then setfootfont(17)
else setfont(17);
grkuc('23)
end
else if c="]" then begin
if foot then setfootfont(17)
else setfont(17);
grklc('23)
end
else if c="λ" then begin
if foot then setfootfont(18)
else setfont(18);
grklc('44)
end
else if c="∞" then begin "xx"
if foot then setfootfont(19)
else setfont(19);
grklc('31)
end "xx"
else if c="β" then begin "xx"
if foot then setfootfont(18)
else setfont(18);
grklc('62)
end "xx"
else if c="α" then begin "xx"
if foot then setfootfont(18)
else setfont(18);
grklc('06)
end "xx"
else if c="'" then begin "xx"
if foot then setfootfont(17)
else setfont(17);
grkss('07)
end "xx"
else if c="/" then begin "xx"
if foot then setfootfont(0)
else setfont(0);
grkss('43)
end "xx"
else if c="→" then begin "xx"
if foot then setfootfont(16)
else setfont(16);
grklc('60)
end "xx"
else if c="|" then begin "xx"
if foot then setfootfont(19)
else setfont(19);
grkss('17)
end "xx"
else if c="*" then begin "xx"
if foot then setfootfont(20)
else setfont(20);
grklc('52)
end "xx"
else if c="ε" then begin "xx"
if foot then setfootfont(18)
else setfont(18);
grklc('02)
end "xx"
else if c="∪" then begin "xx"
if foot then setfootfont(20)
else setfont(20);
grklc('55)
end "xx"
else if c="∩" then begin "xx"
if foot then setfootfont(20)
else setfont(20);
grklc('61)
end "xx"
else if c="""" then begin "qt"
if foot then setfootfont(0)
else setfont(0);
if lft_qt then begin grkuc('21);
grkuc('21); lft_qt←false
end
else begin grklc('21);grklc('21);lft_qt←true
end;
end "qt"
else begin
if foot then setfootfont(17)
else setfont(17);
grklc('17)
end;
if foot then setfootfont(n)
else setfont(n);
end "sp";
! character width stuff;
integer proc comp_lngth(string s);
begin "comp" integer n, s1;string s2;
! s2←s;
n←0;
while s≠null do
begin "loop"
s1←lop(s);
n←cw[cur_font_no,s1]+n;
end "loop";
! outstr("length of "&s2&" is"&cvs(n)&crlf);
! outstr("length of line is"&cvs(run_lngth)&crlf);
return(n);
end"comp";
proc stuff(integer x); ! x is tty code, jam it in punch buffer;
begin
debug("stuff"&cvos(x)&crlf);
punch_buf[loc]←x;
loc←loc+1;
end;
procedure film_adv(string s); ! s is string rep of point, half-point advance;
begin
punch(bell);
punch(eff);
setformat(-3,0);
punch_num(s);
end;
procedure line_meas(integer n); ! n is pixel width of page. punch it;
begin integer pt;
punch(bell);
punch(elll);
! outstr("⊗⊗*******"&cvs(n)&crlf);
pt←(n-offset)/pix_pnt;
! outstr("⊗⊗*******"&cvs(pt)&crlf);
setformat(-4,0);
punch_num(cvs((pt DIV 12)*100+(pt MOD 12)));
end;
proc indentto(integer n); ! manufacture the "bellIL" sequence;
! this should be optimized to kill the film advance;
begin "IN"
if n≠cur_indent then begin "chngind"
integer pt;
string s;
setformat(-4,0);
pt←(n-370.)/pix_pnt;
s←cvs((pt DIV 12)*100+(pt MOD 12));
if text_set then begin
stuff(ql);
bellit;
typeset("m"&slead&",");
end;
bellit;
typeset("il"&s);
cur_indent←n
end "chngind"
end "IN";
proc tab_to(integer n); ! manufacture the guts of the bell X-Y;
! sequence;
begin "IN"
integer pt,m;
string s;
if n=offset then begin last_col←n;return;end;
setformat(-4,0);
m←(n-last_col);
last_col←n;
pt←m/pix_pnt;
s←cvs((pt DIV 12)*100+(pt MOD 12));
debug("tab is "&cvs(n)&";output is "&s&crlf);
if equ(s,"0000") then s←"0001";
tab_cnt←tab_cnt+1;
tab_buf[tab_cnt]←s;
if text_set then stuff(elev) else
begin
stuff(ql);
stuff(elev);
end;
end "IN";
proc tab_tofoot(integer n); ! manufacture the guts of the bell X-Y;
! sequence;
begin "IN"
integer pt,m;
string s;
last_col←n;
if n=offset then return;
if n= tabpos then begin
stuff(emsp);
stuff(emsp);
stuff(emsp);
stuff(emsp);
return
end;
outstr("bad tab in footnote");
end "IN";
! proc setfont(integer n);
! handles superscript and subscripts using real inferiors and
superiors;
proc setfont(integer n);
begin "SF"
if fontsize[n]≠cur_size then begin
bellit;
typeset("p"&(cur_size←fontsize[n]))
end;
if n≠cur_font_no then begin "curfnt"
bellit;
typeset(font[n]);
cur_font_no←n;
end "curfnt";
end "SF";
! proc setfootfont(integer n);
! version of setfont which works on footnotes ;
proc setfootfont(integer n);
begin "SF" string xx;
xx←fontsize[n];
if n=supfont ∨n=subfont then begin end
else if xx="10" then xx ← "08";
if xx≠cur_size then begin
bellit;
typeset("p"&(cur_size←xx))
end;
if n≠cur_font_no then begin "curfnt"
bellit;
typeset(font[n]);
cur_font_no←n;
end "curfnt";
end "SF";
! proc burp( reference integer array p: integer sup1, sub1, text);
! burp will dump line using flash/no flash crap;
proc burp( reference integer array p);
begin "b" integer i;
! if tab_cnt>0 then tab_set(tab_cnt);
for i←0 step 1 until loc-1 do
begin "loop"
punch(p[i]);
end "loop";
punch(elev)
end "b";
! proc burpfoot( reference integer array p: integer sup1, sub1, text);
! burp will dump line in foot note... therefore end with QL only;
proc burpfoot( reference integer array p);
begin "b" integer i;
for i←0 step 1 until loc-1 do
begin "loop"
punch(p[i]);
end "loop";
punch(QL)
end "b";
! proc punch_sum(string s);
proc punch_sum(string s);
begin "sum"
setformat(-3,0);
if tab_cnt>0 then begin
punch(bell);
punch(zee);
punch(bell);
punch(emm);
punch_num(s);
punch(comma);
punch(bell);
punch(you)
end
else begin
punch(bell);
punch(emm);
punch_num(s);
punch(comma);
end;
end"sum";
! procedure setline; ! end of line routine. must check for sup/sub hacking;
! setline dumps line to punch, it will check sum scripts;
procedure setline; ! end of line routine. must check for sup/sub hacking;
begin "SL"
debug("run_lngth is"&cvs(run_lngth)&crlf);
debug("pwidth is"&cvs(pwidth)&crlf);
if uc then begin stuff(unshift);uc←false; end;
if run_lngth=0 ∨ run_lngth=offset then
begin
pwidth←def_width;
line_meas(def_width);
seen_bnd←false;
end
else if run_lngth≠pwidth then
begin
line_meas(run_lngth);
pwidth←run_lngth;
seen_bnd←false;
end;
run_lngth←0;
if tab_cnt>0 then begin tab_to(pwidth);
loc←loc-1;
tab_set(tab_cnt);
end;
burp(punch_buf);
loc←0;
text_set←false;
if tab_cnt>0 then begin punch(bell);
punch(zee);
end;
tab_cnt←0;
last_col←0; ! *********!!!!;
end "SL";
! procedure setfootline; ! end of line routine. must check for sup/sub hacking;
procedure setfootline; ! end of line routine. must check for sup/sub hacking;
begin "SL"
debug("run_lngth is"&cvs(run_lngth)&crlf);
debug("pwidth is"&cvs(pwidth)&crlf);
if uc then begin stuff(unshift);uc←false; end;
if run_lngth=0 ∨ run_lngth=offset then
begin
pwidth←def_width;
line_meas(def_width);
seen_bnd←false;
end
else if run_lngth≠pwidth then
begin
line_meas(run_lngth);
pwidth←run_lngth;
seen_bnd←false;
end;
run_lngth←0;
burpfoot(punch_buf);
loc←0;
text_set←false;
tab_cnt←0;
last_col←0; ! *********!!!!;
end "SL";
! proc linesp(integer n);
! linesp figures the leading to give non-standard interline spacing;
proc linesp(integer n);
begin "LS"
integer m;
m←abs((xline-n)/(h_pix_pnt/2.0));
if m≠0 then begin
string s,s1;
setformat(-3,0);
s←cvs(m MOD 2);
s1←lop(s);
! bellit;
! typeset("m"&cvs((m DIV 2)*10+(m MOD 2))&(if xline>n then ","else "."));
! geezus, is that ugly!!!;
punch(bell);
punch(emm);
punch_num(cvs((m DIV 2)*10+(m MOD 2)));
punch(if xline>n then comma else period);
end;
end "LS";
procedure set_foot;
! set footnotes 8/10 in uncounted format;
! footnote is recognized as (at least) "____" and runs till "<FF>" ;
! will recognize multiple footnotes ;
! does NO hyphenation ;
begin "proc"
string s;
punch(bell);punch(en); ! now make uncounted tape for footnote;
film_adv("100");
foot←true;
while not eof do
BEGIN "SET foot"
s←input(inchan,tolb);
if length(s)≠0 then begin
typeset(s);
text_set←true;
end;
s←input(inchan,torb);
debug(" "&s&crlf);
if equ(s,"SP") ∧ text_set then begin stuff(bnd);text_set←true end
else if equ(s,"SP") ∧ ¬text_set then continue
else if equ(s,"CR") then begin stuff(bnd);text_set←true end
else if equ(s,"LF") then continue
else if equ(s,"LB")then begin
typeset("<");
text_set←true;
end
else if equ(s,"RB")then begin
typeset(">");
text_set←true;
end
else if equ(s,"FF") then begin "foo"
page←page+1;
setfootline;
outstr("punching "&cvs(page)&crlf);
punch(QL);punch(elev);
punch(QL);punch(elev);
punch(QL);punch(elev);
punch(QL);punch(elev);
punch(QL);punch(elev);
punch(QL);punch(elev);
punch(QL);punch(elev);
punch(bell);punch(jay); ! ⊗⊗⊗⊗⊗⊗******;
film_adv(slead); ! ************;
foot←false;
done end "foo"
else begin "BIGcommand"
string s1;
integer br;
s1←scan(s,tospeq,br);
if length(s)=0 then begin outstr("FOO on "&s1&crlf);continue end;
if equ(s1,"COLUMN") then begin
tab_tofoot(cvd(s));
text_set←false;
end
else if equ(s1,"FONT") then setfootfont(cvd(s))
else if equ(s1,"LINESPACE") then begin linesp(cvd(s));
setfootline;
punch(QL);
end
else if equ(s1,"COL") then begin "col inc"
stuff(bnd);
s1←scan(s,tospeq,br); ! flush "INC";
seen_bnd←true;
end "col inc"
else outstr("unrecognized command: "&s1&crlf);
end "BIGcommand";
end "SET foot";
end "proc";
procedure sethead;
! set running heads with bell-dee enspace;
begin "proc"
string s;
! suck "COLUMN #>;
s←input(inchan, tolb);
s←input(inchan,torb);
run_lngth←tab_cnt←0;
while not eof do
BEGIN "SET head"
s←input(inchan,tolb);
if length(s)≠0 then begin
typeset(s);
text_set←true;
end;
s←input(inchan,torb);
debug(" "&s&crlf);
if equ(s,"SP") then stuff(thin)
else if equ(s,"CR") then setfootline ! a cheap way to get "QL";
else if equ(s,"LF") then done
else if equ(s,"LB")then begin
typeset("<");
text_set←true;
end
else if equ(s,"RB")then begin
typeset(">");
text_set←true;
end
else if equ(s,"FF") then begin "foo"
outstr("loss on heading hack"&crlf);
done end "foo"
else begin "BIGcommand"
string s1;
integer br;
s1←scan(s,tospeq,br);
if length(s)=0 then begin outstr("FOO on "&s1&crlf);continue end;
if equ(s1,"COLUMN") then begin
stuff(bell);
stuff(dee);
stuff(ensp);
end
else if equ(s1,"FONT") then setfootfont(cvd(s))
else if equ(s1,"LINESPACE") then begin outstr("heading loss"&crlf);
end
else if equ(s1,"COL") then begin "col inc"
stuff(bnd);
s1←scan(s,tospeq,br); ! flush "INC";
seen_bnd←true;
end "col inc"
else outstr("unrecognized command: "&s1&crlf);
end "BIGcommand";
end "SET head";
end "proc";
begin "MAIN PROGRAM"
setbreak(topar←getbreak, "()", null, "INS");
setbreak(tospeq←getbreak, " =", null, "INS");
setbreak(toppn←getbreak, "[", null, "INR");
setbreak(todot←getbreak, ".",null, "INS");
setbreak(tocolon←getbreak, ":", null,"INS");
while true do
begin "IN"
outstr("name.ext (n:m)? (n≥2; always uses page 1)
");
open (inchan,"DSK",0,2,0,200,0,eof);
open (ptpchan, "PTP", '10,0,2,0,0,0);
! initialize some crap;
seen_bnd←true; ! initialized true to force initial line length;
run_lngth←0;
pwidth ← -1;
uc ← false;
loc←0;
cur_size←null;
cur_font_no←-1;
cur_indent←-1;
text_set←false;
tab_cnt←0;
last_col←0; ! *************;
offset←351;
tabpos ←423; ! sigh ;
foot←false;
pix_pnt←(200.0/72.0)*(30.0/29.0); ! holy shit!!!!!!!;
h_pix_pnt←(200.0/72.0);
while true do
begin "file"
string file;
outstr("*");
S← inchwl;
ext ←scan(s,topar,i);
file←scan(ext,todot,i);
if length(ext)=0 then ext←"TYP";
s1←cvxstr(call(0,"dskppn"));
if defile(inchan,file,ext,s1[1 to 3],s1[4 to 6])
then outstr("FILE NOT FOUND: "&file&crlf)
else done;
end "file";
outstr("output to tty? yes → tty; no→ punch.(y/n)?"&crlf);
s1←inchwl;
if s1="y" or s1="Y" then foo ←true else foo←false;
comment add crap for page number location (suck for "<FF>");
if s=null then begin
pagebeg←2;
pagend←7000;
end
else begin
pagebeg←cvd(scan(s,tocolon,i));
if s="*" then pagend←7000
else pagend←cvd(s);
end;
comment read page 1;
BEGIN "PAGE1"
setbreak(page1←getbreak,"/<>=#",crlfff,"INS");
s1←input(inchan,page1); ! flush leading cr-lf and "/";
if length(s1)≠0
then begin
outstr(cvs(length(s1))&" not proper file format"&crlf);done
end;
s1←input(inchan,page1); ! snarf "lmar=";
lmar←cvd(input(inchan,page1)); ! save left margin setting;
s1←input(inchan,page1); ! snarf "xline=";
xline←cvd(input(inchan,page1)); ! save leading;
while true do
begin "FONTS"
integer f;
string name,s3,s4,f1;
if equ(input(inchan,page1), "CR") ! scan to"#" to get to font number;
then done;
f←cvd(f1 ← input(inchan,page1));! get font number;
name ← input(inchan,page1); ! get sail font name;
! cw_print(name,f); ! get chr widths of name and stuff in cw[f,0:127];
cw_init(name,f); ! get chr widths of name and stuff in cw[f,0:127];
if font[f]=null then begin "ask font"
outstr("font "&f1&" is "&name&crlf);
outstr("give VIP position and point size (a-c&1-6&(1-99))
*");
s3←inchwl;
s4←scan(s3,topar,i);
font[f]←s4;
s4←scan(s3,topar,i);
fontsize[f]←s4;
end "ask font";
if equ(name,"SUB") then subfont←f
else if equ(name,"SUP") then supfont←f;
end "FONTS";
lft_qt←true;
! outstr("linelength in picas and points (aaoo)?"&crlf&"*");
! width ← cvd(swidth←"4000");
! pwidth←pix_pnt*12.*(width/100.);
pwidth←1359;
def_width←1359;
! outstr("standard leading (points and half-points (ooh)?"&crlf&"*");
! lead ← cvd(slead←inchwl);
lead ← (lead+xline)/(h_pix_pnt/2.0);
slead← cvs((lead DIV 2)*10+(lead MOD 2)); ! lead set in cw_init;
END "PAGE1";
! outstr("end of fonts");
! page←inchwl;
page←2;
input(inchan,page1); ! snarf "<";
input(inchan,page1); ! snarf "LF>";
input(inchan,page1); ! snarf "<";
input(inchan,page1); ! snarf "FF>";
film_adv(slead); ! punch film advance **********;
line_meas(pwidth); ! punch line page width;
punch(bell);
punch(jay); ! do it in justified mode;
punch(bell);punch(gee); ! no hypenation;
punch(bell);punch(kay); punch(zero); ! no letterspacing;
setbreak(tolb←getbreak,"<",crlfffsp,"INS");
setbreak(torb←getbreak,">",crlfff,"INS");
while page≠pagebeg do
begin "suck"
s←input(inchan,tolb);
s←input(inchan,torb);
if equ(s,"FF") then page←page+1;
end"suck";
SETHEAD;
while page ≤pagend and not eof do
BEGIN "SET TEXT"
while not eof do
BEGIN "SET PAGE"
s←input(inchan,tolb);
if length(s)≠0 then begin
if equ(s, "________________") then begin
input(inchan,page1); ! CR>;
input(inchan,page1); ! <;
input(inchan,page1); ! linespace 3>;
punch(QL);punch(elev);
punch(QL);punch(elev);
set_foot;
SETHEAD;
continue
end
else begin
run_lngth←run_lngth+comp_lngth(s);
typeset(s);
text_set←true;
end;
end;
s←input(inchan,torb);
debug(" "&s&crlf);
if equ(s,"SP") then begin "foo1"
run_lngth←run_lngth+comp_lngth(" ");
stuff(thin); ! *********stuff(ensp);
end "foo1"
else if equ(s,"CR") then setline
else if equ(s,"LF") then continue
else if equ(s,"LB")then begin
run_lngth←run_lngth+comp_lngth("<");
typeset("<");
text_set←true;
end
else if equ(s,"RB")then begin
run_lngth←run_lngth+comp_lngth(">");
text_set←true;
typeset(">");
end
else if equ(s,"FF") then begin "foo"
page←page+1;
outstr("punching "&cvs(page)&crlf);
punch(QL);punch(elev);
punch(QL);punch(elev);
punch(QL);punch(elev);
punch(QL);punch(elev);
punch(QL);punch(elev);
punch(QL);punch(elev);
punch(QL);punch(elev);
SETHEAD;
done end "foo"
else begin "BIGcommand"
string s1;
integer br;
s1←scan(s,tospeq,br);
if length(s)=0 then begin outstr("FOO on "&s1&crlf);continue end;
if equ(s1,"COLUMN") then begin
tab_to(cvd(s));
text_set←false;
run_lngth←cvd(s)
end
else if equ(s1,"FONT") then setfont(cvd(s))
else if equ(s1,"LINESPACE") then linesp(cvd(s))
else if equ(s1,"COL") then begin "col inc"
stuff(bnd);
s1←scan(s,tospeq,br); ! flush "INC";
run_lngth←run_lngth+cvd(s);
seen_bnd←true;
end "col inc"
else outstr("unrecognized command: "&s1&crlf);
end "BIGcommand";
end "SET PAGE";
end "SET TEXT";
bellit;
typeset("s");
setline
end "IN";
end "MAIN PROGRAM";
end "TYPESET"